# mean of both relationship durations reported
df_wide$rel_duration_A <- df_wide$pre_rel_duration_y_A + df_wide$pre_rel_duration_m_A / 12 # in months
df_wide$rel_duration_B <- df_wide$pre_rel_duration_y_B + df_wide$pre_rel_duration_m_B / 12
df_wide$Relationship_Duration <- (df_wide$rel_duration_A + df_wide$rel_duration_B) / 2
# mean of both cohabiting duration reported
df_wide$hab_duration_A <- df_wide$pre_hab_duration_y_A + df_wide$pre_hab_duration_m_A / 12
df_wide$hab_duration_B <- df_wide$pre_hab_duration_y_B + df_wide$pre_hab_duration_m_B / 12
df_wide$Cohabiting_Duration <- (df_wide$hab_duration_A + df_wide$hab_duration_B) / 2
#Gender of Each Partner
df_wide$Gender_A <- factor(df_wide$gender_A, levels = c(1,2,3), labels = c('Male','Female', 'Other'))
df_wide$Gender_B <- factor(df_wide$gender_B, levels = c(1,2,3), labels = c('Male','Female', 'Other'))
#Same sex couples or not
df_wide$Same_Sex <- factor(df_wide$Gender_A == df_wide$Gender_B, levels = c(FALSE, TRUE), labels = c('Same-Sex Couple', 'Mixed-Sex Couple'))
#Handedness
df_wide$Handedness_A <- factor(df_wide$pre_handedness_A, levels = c(0, 1, 2), c('Right','Left', 'Ambidextrous'))
df_wide$Handedness_B <- factor(df_wide$pre_handedness_B, levels = c(0, 1, 2), c('Right','Left', 'Ambidextrous'))
# Income (mean of both partner's report)
merge_income <- function(income1, income2) {
merged_income <- numeric(length(income1))
# Loop through each pair of incomes
for (i in seq_along(income1)) {
# Handle NA
if (is.na(income1[i])) {
merged_income[i] <- income2[i]
}
else if (is.na(income2[i])) {
merged_income[i] <- income1[i]
}
# if both are informative, take mean and round
else if (income1[i] %in% 1:6 && income2[i] %in% 1:6) {
merged_income[i] <- round((income1[i] + income2[i]) / 2)
}
# if one is informative and the other not, use the informative one.
else if (income1[i] %in% 1:6) {
merged_income[i] <- income1[i]
}
else if (income2[i] %in% 1:6) {
merged_income[i] <- income2[i]
}
# Now we only have cases, where both are either 70 or 99. We simply report "undisclosed".
else {
merged_income[i] <- 99
}
}
return(merged_income)
}
# Apply the function
numeric_income <- merge_income(df_wide$pre_income_1_A, df_wide$pre_income_1_B)
# Convert to factor
df_wide$Household_Income <- factor(numeric_income, levels = c(1,2,3,4,5,6,70,99), labels = c(
"up to CHF 2'000.-",
"CHF 2'001.- to CHF 4'000.-",
"CHF 4'001.- to CHF 6'000.-",
"CHF 6'001.- to CHF 8'000.-",
"CHF 8'001.- to CHF 10'000.-",
"above CHF 10'000.-",
"I don't know",
"Undisclosed"
))
# Education for both separate
df_wide$Highest_Education_A <- factor(df_wide$pre_education_A, levels = c(1,2,3,4,5,6,7), labels = c(
"(still) no school diploma",
"compulsory education (9 years)",
"vocational training (apprenticeship)",
"Matura (university entrance qualification)",
"Bachelor's degree",
"Master's degree",
"Doctorate degree"
)
)
df_wide$Highest_Education_B <- factor(df_wide$pre_education_B, levels = c(1,2,3,4,5,6,7), labels = c(
"(still) no school diploma",
"compulsory education (9 years)",
"vocational training (apprenticeship)",
"Matura (university entrance qualification)",
"Bachelor's degree",
"Master's degree",
"Doctorate degree"
)
)
# Marital Status (married)
df_wide$Marital_Status_A <- df_wide$pre_mat_stat_A == 1
df_wide$Marital_status_B <- df_wide$pre_mat_stat_B == 1
# if at least one of them said they are married, we go for married
df_wide$Marital_Status <- factor((df_wide$Marital_Status_A + df_wide$Marital_status_B) > 0, levels = c(FALSE, TRUE), labels = c('Not Married', 'Married'))
# Children
df_wide$Children <- factor((df_wide$pre_child_option_A + df_wide$pre_child_option_B) > 0, levels = c(FALSE, TRUE), labels = c('Have Children', 'No Children'))
# number of chilren (ONLY FOR COUPLES THAT HAVE CHILDREN)
df_wide$nChildren_couples_with_children <- (df_wide$pre_child_nr_childs_A + df_wide$pre_child_nr_childs_B) / 2
# number of children if every couple is considered.
df_wide$nChildren_all_couples <- df_wide$nChildren_couples_with_children
df_wide$nChildren_all_couples[is.na(df_wide$nChildren_all_couples)] <- 0
# BMI (kg/m^2)
df_wide$pre_height_A <- df_wide$pre_height_A / 100 # to meters
df_wide$pre_height_B <- df_wide$pre_height_B / 100 # to meters
df_wide$BMI_A <- df_wide$pre_weight_A / (df_wide$pre_height_A^2)
df_wide$BMI_B <- df_wide$pre_weight_B / (df_wide$pre_height_B^2)
sample_measures <- c(
"Gender_A", "Gender_B", "Same_Sex",
"pre_age_A", "pre_age_B", "BMI_A", "BMI_B", "Handedness_A", "Handedness_B", # physical stats
"Household_Income", "Highest_Education_A", "Highest_Education_B", # SES
"Marital_Status", "Relationship_Duration", "Cohabiting_Duration",
"Children", "nChildren_all_couples", "nChildren_couples_with_children"
)
sample_table <- report_measures(df_wide, sample_measures, ICC=F)
rownames(sample_table) <- NULL
openxlsx::write.xlsx(sample_table, 'Output/Sample.xlsx')
print_df(sample_table)
Modelling using the gaussian family fails. Due to the many zeros,
transformations won’t help estimating the models. We employ the negative
binomial family.
We tried negative binomial here as well for consistency, but the model
did not converge. Poisson also did not work. As we have no zeros in this
distribution, we log transform.
